Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Code Resources/Eclectic CDEFs/CDEFTester Folder/CDEFTesterDemo.p

Text File | 1997-03-05 | 16.7 KB | 593 lines | [TEXT/PJMM]

{    CDEF Collection Demo    }
{}
{    Main program for demonstrating the CDEF Collection    }
{}
{    Copyright © Sebastiano Pilla 1996    }
{    All rights reserved    }

{    <mailto:[e-mail]>    }

{    Note: This code is for demonstrational purposes only. It is probably the ugliest code I ever wrote; on the    }
{    other hand, I whipped up in about 4 hours an example of all the techniques needed to use the StubCDEF and JumpCDEF    }
{    "fake" defprocs.    }

program CDEFCollectionDemo;


    uses
        Controls, CelsiusCDEFStub, StubCDEFIntf, GaussCDEFStub, JumpCDEFIntf, MovableModal;


    const
        rCelsiusDemoDialogID = 128;

        kRunCelsiusDemoItem = 1;
        kToggleCelsiusItemsItem = 2;
        kFirstCelsiusControlItem = 3;
        kLastCelsiusControlItem = 18;
        kExitCelsiusDemoItem = 29;


    const
        kCelsiusCtlMin = 0;
        kCelsiusCtlMax = 200;


    procedure DoCelsiusCDEFDemo;
        var
            theRect: Rect;
            savePort: GrafPtr;
            theHandle: Handle;
            theDialog: DialogPtr;
            junk: SInt32;
            theControls: array[kFirstCelsiusControlItem..kLastCelsiusControlItem] of ControlHandle;
            theItem, j, theType, val: SInt16;
            hilited: Boolean;
    begin
        GetPort(savePort);
        theDialog := GetNewDialog(rCelsiusDemoDialogID, nil, WindowPtr(-1));
        if theDialog = nil then
            Exit(DoCelsiusCDEFDemo);
        for j := kFirstCelsiusControlItem to kLastCelsiusControlItem do
            begin
                GetDialogItem(theDialog, j, theType, theHandle, theRect);
                theControls[j] := ControlHandle(theHandle);
                junk := AttachRealCDEFUPP(ControlDefProcPtr(@CelsiusCDEF), theControls[j]);
                SetControlMinimum(theControls[j], kCelsiusCtlMin);
                SetControlMaximum(theControls[j], kCelsiusCtlMax);
                SetControlValue(theControls[j], kCelsiusCtlMin);
                HiliteControl(theControls[j], kControlNoPart);
            end;
        hilited := true;
        ShowWindow(theDialog);
        SelectWindow(theDialog);
        SetPort(theDialog);
        DrawDialog(theDialog);
        theItem := 0;
        while theItem <> kExitCelsiusDemoItem do
            begin
                MovableModalDialog(nil, theItem);
                case theItem of
                    kRunCelsiusDemoItem:
                        begin
                            SetCursor(GetCursor(watchCursor)^^);
                            for val := kCelsiusCtlMin to kCelsiusCtlMax do
                                for j := kFirstCelsiusControlItem to kLastCelsiusControlItem do
                                    SetControlValue(theControls[j], val);
                            for j := kFirstCelsiusControlItem to kLastCelsiusControlItem do
                                SetControlValue(theControls[j], 0);
                            SetCursor(arrow);
                        end;
                    kToggleCelsiusItemsItem:
                        begin
                            if hilited then
                                begin
                                    for j := kFirstCelsiusControlItem to kLastCelsiusControlItem do
                                        HiliteControl(theControls[j], kControlInactivePart);
                                    hilited := false;
                                end
                            else
                                begin
                                    for j := kFirstCelsiusControlItem to kLastCelsiusControlItem do
                                        HiliteControl(theControls[j], kControlNoPart);
                                    hilited := true;
                                end;
                        end;
                    otherwise
                        ;
                end;
            end;
        for j := kFirstCelsiusControlItem to kLastCelsiusControlItem do
            junk := RemoveRealCDEFUPP(theControls[j]);
        DisposeDialog(theDialog);
        SetPort(savePort);
    end;


    const
        rGaussDemoDialogID = 129;

        kToggleGaussItemsItem = 1;
        kExitGaussDemoItem = 2;

        kGaussControlUserItem = 3;

        kDrawTitleOnlyRadioBtnItem = 4;
        kDrawTitleAndValueRadioBtnItem = 5;
        kDrawValueOnlyRadioBtnItem = 6;
        kDrawTextFromRefConRadioBtnItem = 7;

        kAlignLeftRadioBtnItem = 8;
        kAlignCenterRadioBtnItem = 9;
        kAlignRightRadioBtnItem = 10;
        kFullJustRadioBtnItem = 11;

        kUseWFontCheckItem = 12;
        kDrawBoundsRectCheckItem = 13;
        kDoNotDimCheckItem = 14;
        kDraw3DEffectCheckItem = 15;
        kUseStdColorsCheckItem = 16;

        rTitlesStrListID = 128;
        kTitleOnlyIndex = 1;
        kTitleAndValueIndex = 2;


    type
        FunctionalSpecs = packed array[kDrawTitleOnlyRadioBtnItem..kDrawTextFromRefConRadioBtnItem] of SInt8;
        AlignmentSpecs = packed array[kAlignLeftRadioBtnItem..kFullJustRadioBtnItem] of SInt8;
        AppearanceSpecs = packed array[kUseWFontCheckItem..kUseStdColorsCheckItem] of SInt8;


    procedure InitDialogButtons (inDialog: DialogPtr;
                                    var outFuncSpecs: FunctionalSpecs;
                                    var outAlignSpecs: AlignmentSpecs;
                                    var outAppearSpecs: AppearanceSpecs);
        var
            theRect: Rect;
            theHandle: Handle;
            i, theType: SInt16;
    begin
        outFuncSpecs[kDrawTitleOnlyRadioBtnItem] := 1;
        for i := kDrawTitleAndValueRadioBtnItem to kDrawTextFromRefConRadioBtnItem do
            outFuncSpecs[i] := 0;
        outAlignSpecs[kAlignLeftRadioBtnItem] := 1;
        for i := kAlignCenterRadioBtnItem to kFullJustRadioBtnItem do
            outAlignSpecs[i] := 0;
        for i := kUseWFontCheckItem to kUseStdColorsCheckItem do
            outAppearSpecs[i] := 0;
        for i := kDrawTitleOnlyRadioBtnItem to kDrawTextFromRefConRadioBtnItem do
            begin
                GetDialogItem(inDialog, i, theType, theHandle, theRect);
                SetControlValue(ControlHandle(theHandle), outFuncSpecs[i]);
            end;
        for i := kAlignLeftRadioBtnItem to kFullJustRadioBtnItem do
            begin
                GetDialogItem(inDialog, i, theType, theHandle, theRect);
                SetControlValue(ControlHandle(theHandle), outAlignSpecs[i]);
            end;
        for i := kUseWFontCheckItem to kUseStdColorsCheckItem do
            begin
                GetDialogItem(inDialog, i, theType, theHandle, theRect);
                SetControlValue(ControlHandle(theHandle), outAppearSpecs[i]);
            end;
    end;


    const
        kGaussMinimumCtlMax = 128;

        kGaussEffectThreshold = -100;

        kDrawTitleAndValueVarCodeMask = $1;
        kDrawValueOnlyVarCodeMask = $2;
        kDrawTextFromRefConVarCodeMask = $4;
        kUseWindowFontVarCodeMask = $8;

        kDrawBoundingRectangleExtVarCodeMask = $100;
        kNeverDimControlExtVarCodeMask = $200;
        kDraw3DEffectExtVarCodeMask = $400;
        kUseStdColorsExtVarCodeMask = $800;

        rJumpCDEFID = 128;

        rTextID = 128;


    function CreateGaussDemoControl (inDialog: DialogPtr;
                                    inFuncSpecs: FunctionalSpecs;
                                    inAlignSpecs: AlignmentSpecs;
                                    inAppearSpecs: AppearanceSpecs;
                                    inEffect: SInt16;
                                    inHilited: boolean): ControlHandle;
        var
            theTitle: Str255;
            theRect: Rect;
            theHandle: Handle;
            theControl: ControlHandle;
            theRefCon: SInt32;
            theType, theAlign, theMin, theMax, theVarCode: SInt16;
    begin
        theControl := nil;
        CreateGaussDemoControl := nil;
        GetDialogItem(inDialog, kGaussControlUserItem, theType, theHandle, theRect);
        if inFuncSpecs[kDrawTitleOnlyRadioBtnItem] = 1 then
            GetIndString(theTitle, rTitlesStrListID, kTitleOnlyIndex)
        else if inFuncSpecs[kDrawTitleAndValueRadioBtnItem] = 1 then
            GetIndString(theTitle, rTitlesStrListID, kTitleAndValueIndex)
        else
            theTitle := '';
        if inAlignSpecs[kAlignLeftRadioBtnItem] = 1 then
            theAlign := teJustLeft
        else if inAlignSpecs[kAlignCenterRadioBtnItem] = 1 then
            theAlign := teJustCenter
        else if inAlignSpecs[kAlignRightRadioBtnItem] = 1 then
            theAlign := teJustRight
        else if inAlignSpecs[kFullJustRadioBtnItem] = 1 then
            theAlign := ntbJustFull;
        theMin := kGaussEffectThreshold;
        if inAppearSpecs[kDraw3DEffectCheckItem] = 1 then
            theMin := inEffect;
        theMax := kGaussMinimumCtlMax;
        if inAppearSpecs[kDrawBoundsRectCheckItem] = 1 then
            theMax := theMax + kDrawBoundingRectangleExtVarCodeMask;
        if inAppearSpecs[kDoNotDimCheckItem] = 1 then
            theMax := theMax + kNeverDimControlExtVarCodeMask;
        if inAppearSpecs[kDraw3DEffectCheckItem] = 1 then
            theMax := theMax + kDraw3DEffectExtVarCodeMask;
        if inAppearSpecs[kUseStdColorsCheckItem] = 1 then
            theMax := theMax + kUseStdColorsExtVarCodeMask;
        theVarCode := 0;
        if inFuncSpecs[kDrawTitleAndValueRadioBtnItem] = 1 then
            theVarCode := theVarCode + kDrawTitleAndValueVarCodeMask;
        if inFuncSpecs[kDrawValueOnlyRadioBtnItem] = 1 then
            theVarCode := theVarCode + kDrawValueOnlyVarCodeMask;
        if inFuncSpecs[kDrawTextFromRefConRadioBtnItem] = 1 then
            theVarCode := theVarCode + kDrawTextFromRefConVarCodeMask;
        if inAppearSpecs[kUseWFontCheckItem] = 1 then
            theVarCode := theVarCode + kUseWindowFontVarCodeMask;
        if inFuncSpecs[kDrawTextFromRefConRadioBtnItem] = 1 then
            begin
                theHandle := GetResource('TEXT', rTextID);
                if theHandle = nil then
                    Exit(CreateGaussDemoControl);
                theRefCon := SInt32(theHandle);
            end
        else
            theRefCon := BOR(Random, BSL(Random, 16));
        theControl := NewControl(inDialog, theRect, theTitle, false, theAlign, theMin, theMax, (16 * rJumpCDEFID) + theVarCode, theRefCon);
        if theControl <> nil then
            begin
                if inHilited then
                    HiliteControl(theControl, kControlNoPart)
                else
                    HiliteControl(theControl, kControlInactivePart);
                ShowControl(theControl);
            end;
        CreateGaussDemoControl := theControl;
    end;


    function DoFunctionalSpecsClick (inDialog: DialogPtr;
                                    inItemClicked, inFirstItemInRange, inLastItemInRange: SInt16): FunctionalSpecs;
        var
            theRect: Rect;
            theHandle: Handle;
            i, theType: SInt16;
            theFuncSpecs: FunctionalSpecs;
    begin
        for i := inFirstItemInRange to inLastItemInRange do
            begin
                GetDialogItem(inDialog, i, theType, theHandle, theRect);
                if i = inItemClicked then
                    theFuncSpecs[i] := 1
                else
                    theFuncSpecs[i] := 0;
                SetControlValue(ControlHandle(theHandle), theFuncSpecs[i]);
            end;
        DoFunctionalSpecsClick := theFuncSpecs;
    end;


    function DoAlignmentSpecsClick (inDialog: DialogPtr;
                                    inItemClicked, inFirstItemInRange, inLastItemInRange: SInt16;
                                    var outVal: SInt16): AlignmentSpecs;
        var
            theRect: Rect;
            theHandle: Handle;
            i, theType: SInt16;
            theAlignSpecs: AlignmentSpecs;
    begin
        for i := inFirstItemInRange to inLastItemInRange do
            begin
                GetDialogItem(inDialog, i, theType, theHandle, theRect);
                if i = inItemClicked then
                    theAlignSpecs[i] := 1
                else
                    theAlignSpecs[i] := 0;
                SetControlValue(ControlHandle(theHandle), theAlignSpecs[i]);
            end;
        case inItemClicked of
            kAlignLeftRadioBtnItem:
                outVal := teJustLeft;
            kAlignCenterRadioBtnItem:
                outVal := teJustCenter;
            kAlignRightRadioBtnItem:
                outVal := teJustRight;
            kFullJustRadioBtnItem:
                outVal := ntbJustFull;
        end;
        DoAlignmentSpecsClick := theAlignSpecs;
    end;


    procedure DoAppearanceSpecsClick (inDialog: DialogPtr;
                                    inItemClicked, inFirstItemInRange, inLastItemInRange: SInt16;
                                    var ioAppearSpecs: AppearanceSpecs);
        var
            theRect: Rect;
            theHandle: Handle;
            i, theType: SInt16;
    begin
        if ioAppearSpecs[inItemClicked] = 1 then
            begin
                ioAppearSpecs[inItemClicked] := 0;
                if (inItemClicked = kDrawBoundsRectCheckItem) and (ioAppearSpecs[kDraw3DEffectCheckItem] = 1) then
                    ioAppearSpecs[kDraw3DEffectCheckItem] := 0;
            end
        else if ioAppearSpecs[inItemClicked] = 0 then
            begin
                ioAppearSpecs[inItemClicked] := 1;
                if (inItemClicked = kDraw3DEffectCheckItem) and (ioAppearSpecs[kDrawBoundsRectCheckItem] = 0) then
                    ioAppearSpecs[kDrawBoundsRectCheckItem] := 1;
            end;
        for i := inFirstItemInRange to inLastItemInRange do
            begin
                GetDialogItem(inDialog, i, theType, theHandle, theRect);
                SetControlValue(ControlHandle(theHandle), ioAppearSpecs[i]);
            end;
    end;


    procedure DoGaussCDEFDemo;
        var
            theDialog: DialogPtr;
            savePort: GrafPtr;
            theControl: ControlHandle;
            theNum, theEffect, theVal: SInt16;
            err: OSErr;
            theFuncSpecs: FunctionalSpecs;
            theAlignSpecs: AlignmentSpecs;
            theAppearSpecs: AppearanceSpecs;
            hilited: Boolean;
    begin
        GetPort(savePort);
        theDialog := GetNewDialog(rGaussDemoDialogID, nil, WindowPtr(-1));
        if theDialog = nil then
            Exit(DoGaussCDEFDemo);
        err := InstallCDEFUPP(@GaussCDEF);
        hilited := true;
        SetPort(theDialog);
        GetFNum('Geneva', theNum);
        TextFont(theNum);
        TextSize(9);
        TextFace([bold]);
        InitDialogButtons(theDialog, theFuncSpecs, theAlignSpecs, theAppearSpecs);
        ShowWindow(theDialog);
        SelectWindow(theDialog);
        theEffect := kGaussEffectThreshold;
        theControl := CreateGaussDemoControl(theDialog, theFuncSpecs, theAlignSpecs, theAppearSpecs, theEffect, hilited);
        if theControl = nil then
            begin
                DisposeDialog(theDialog);
                Exit(DoGaussCDEFDemo);
            end;
        DrawDialog(theDialog);
        theNum := 0;
        while theNum <> kExitGaussDemoItem do
            begin
                MovableModalDialog(nil, theNum);
                case theNum of
                    kToggleGaussItemsItem:
                        if hilited then
                            begin
                                HiliteControl(theControl, kControlInactivePart);
                                hilited := false;
                            end
                        else
                            begin
                                HiliteControl(theControl, kControlNoPart);
                                hilited := true;
                            end;
                    kGaussControlUserItem:
                        begin
                            theEffect := GetControlMinimum(theControl);
                            if theEffect < kGaussEffectThreshold then
                                theEffect := kGaussEffectThreshold
                            else if theEffect = kGaussEffectThreshold then
                                theEffect := kGaussEffectThreshold + 1
                            else if theEffect > kGaussEffectThreshold then
                                theEffect := kGaussEffectThreshold - 1;
                            SetControlMinimum(theControl, theEffect);
                        end;
                    kDrawTitleOnlyRadioBtnItem..kDrawTextFromRefConRadioBtnItem:
                        begin
                            DisposeControl(theControl);
                            theFuncSpecs := DoFunctionalSpecsClick(theDialog, theNum, kDrawTitleOnlyRadioBtnItem, kDrawTextFromRefConRadioBtnItem);
                            theControl := CreateGaussDemoControl(theDialog, theFuncSpecs, theAlignSpecs, theAppearSpecs, theEffect, hilited);
                        end;
                    kAlignLeftRadioBtnItem..kFullJustRadioBtnItem:
                        begin
                            theAlignSpecs := DoAlignmentSpecsClick(theDialog, theNum, kAlignLeftRadioBtnItem, kFullJustRadioBtnItem, theVal);
                            SetControlValue(theControl, theVal);
                        end;
                    kUseWFontCheckItem..kUseStdColorsCheckItem:
                        begin
                            DisposeControl(theControl);
                            DoAppearanceSpecsClick(theDialog, theNum, kUseWFontCheckItem, kUseStdColorsCheckItem, theAppearSpecs);
                            theControl := CreateGaussDemoControl(theDialog, theFuncSpecs, theAlignSpecs, theAppearSpecs, theEffect, hilited);
                        end;
                    otherwise
                        ;
                end;
            end;
        DisposeDialog(theDialog);
        SetPort(savePort);
    end;


    const
        kNumMenus = 3;


    const
        rAppleMenuID = 128;
        kAppleMenuIndex = 1;
        kAboutItem = 1;

        rFileMenuID = 129;
        kFileMenuIndex = 2;
        kQuitItem = 1;

        rDemosMenuID = 130;
        kDemosMenuIndex = 3;
        kCelsiusCDEFDemoItem = 1;
        kGaussCDEFDemoItem = 2;

        rAboutAlertID = 128;


    var
        gMenus: array[1..kNumMenus] of MenuHandle;
        gInx: SInt16;
        gDoneFlag: Boolean;
        gTheEvent: EventRecord;


    procedure DoMenuCommand (inCommand: SInt32);
        var
            daName: Str255;
            theMenu, theItem, junk: SInt16;
    begin
        if inCommand = 0 then
            Exit(DoMenuCommand);
        theMenu := HiWord(inCommand);
        theItem := LoWord(inCommand);
        case theMenu of
            rAppleMenuID:
                if theItem = kAboutItem then
                    junk := Alert(rAboutAlertID, nil)
                else
                    begin
                        GetMenuItemText(GetMenuHandle(rAppleMenuID), theItem, daName);
                        junk := OpenDeskAcc(daName);
                    end;
            rFileMenuID:
                if theItem = kQuitItem then
                    gDoneFlag := true;
            rDemosMenuID:
                case theItem of
                    kCelsiusCDEFDemoItem..kGaussCDEFDemoItem:
                        begin
                            DisableItem(gMenus[kAppleMenuIndex], kAboutItem);
                            DisableItem(gMenus[kFileMenuIndex], 0);
                            DisableItem(gMenus[kDemosMenuIndex], 0);
                            DrawMenuBar;
                            if theItem = kCelsiusCDEFDemoItem then
                                DoCelsiusCDEFDemo
                            else if theItem = kGaussCDEFDemoItem then
                                DoGaussCDEFDemo;
                            EnableItem(gMenus[kAppleMenuIndex], kAboutItem);
                            EnableItem(gMenus[kFileMenuIndex], 0);
                            EnableItem(gMenus[kDemosMenuIndex], 0);
                            DrawMenuBar;
                        end;
                    otherwise
                        ;
                end;
            otherwise
                ;
        end;
        HiliteMenu(0);
        DrawMenuBar;
    end;


    procedure DoMouseEvent (inEvent: EventRecord);
        var
            thePoint: Point;
            theWindow: WindowPtr;
            thePart: SInt16;
    begin
        thePoint := inEvent.where;
        thePart := FindWindow(thePoint, theWindow);
        case thePart of
            inMenuBar:
                DoMenuCommand(MenuSelect(thePoint));
            inSysWindow:
                SystemClick(inEvent, theWindow);
            otherwise
                ;
        end;
    end;


    procedure DoKeyEvent (inEvent: EventRecord);
        var
            theChar: Char;
    begin
        if BAND(inEvent.modifiers, cmdKey) <> 0 then
            DoMenuCommand(MenuKey(Chr(BAND(inEvent.message, charCodeMask))));
    end;


    procedure DoUpdateEvent (inEvent: EventRecord);
    begin
        BeginUpdate(WindowPtr(inEvent.message));
        EndUpdate(WindowPtr(inEvent.message));
    end;


    procedure DoActivateEvent (inEvent: EventRecord);
    begin
    end;


{$I-}
begin
    InitGraf(@thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);
    InitCursor;
    FlushEvents(everyEvent, 0);

    gDoneFlag := false;

    gMenus[kAppleMenuIndex] := GetMenu(rAppleMenuID);
    AppendResMenu(gMenus[kAppleMenuIndex], 'DRVR');
    gMenus[kFileMenuIndex] := GetMenu(rFileMenuID);
    gMenus[kDemosMenuIndex] := GetMenu(rDemosMenuID);
    for gInx := 1 to kNumMenus do
        InsertMenu(gMenus[gInx], 0);
    DrawMenuBar;

    while not gDoneFlag do
        begin
            if WaitNextEvent(everyEvent, gTheEvent, MaxInt, nil) then
                case gTheEvent.what of
                    mouseDown:
                        DoMouseEvent(gTheEvent);
                    keyDown, keyUp, autoKey:
                        DoKeyEvent(gTheEvent);
                    updateEvt:
                        DoUpdateEvent(gTheEvent);
                    activateEvt:
                        DoActivateEvent(gTheEvent);
                    otherwise
                        ;
                end;
        end;
end.